HPAVC/HPAVC CD-ROM.iso/MYMUD21.ZIP/MMUD21.ZIP/SOURCE/SOURCE.ZIP/MISC.PAS

Pascal/Delphi Source File | 1995-01-21 | 9KB | 353 lines

{$I COPYRGHT.INC}

(*----------------------------------------------------------------------------*

  General misc. fucntions and procedures.

 *---------------------------------------------------------------------------*)


Unit Misc;
Interface
Uses Dos;


(*---------------------------------------------------------------------------*
   UpStr    Convert a string to uppercase
   MakeStr  Add a CHAR to a string until the length is LEN
 *---------------------------------------------------------------------------*)
Function UpStr(S : String):String;
Function MakeStr(S : String;C : Char;Len : Byte):String;

(*---------------------------------------------------------------------------*
  Convert Nr to string and viceversa
 *---------------------------------------------------------------------------*)
Function Nr2Str(Nr : Integer):String;
Function Str2Nr(S : String):Integer;
Function Nr2FStr(Nr : Integer;Len : Byte):String;

(*---------------------------------------------------------------------------*
  Clean up an string. Delete leading and trailing spaces
 *---------------------------------------------------------------------------*)
Function CleanUp(S : String):String;

(*---------------------------------------------------------------------------*
  MakeTimeString     Convert a longint timestamp to a string
  TimeStamp          Return a complete time/date string
 *---------------------------------------------------------------------------*)
Function MakeTimeString(Stamp : LongInt):String;
Function TimeStamp:String;

(*---------------------------------------------------------------------------*
   Splits a commandline <Object>=<Action> in the object and the action
   part
 *---------------------------------------------------------------------------*)
Function SplitCommand(     InpStr : String;
                       Var ObjName: String;
                       Var Action : String):Boolean;

(*---------------------------------------------------------------------------*
  BitLevel functions
 *---------------------------------------------------------------------------*)

Procedure ReSetBit(Var L : LongInt; Flag : LongInt);
Procedure SetBit(Var L : LongInt; Flag : LongInt);
Function BitSet(L,Flag : LongInt):Boolean;

(*---------------------------------------------------------------------------*
  Check if a file exists
 *---------------------------------------------------------------------------*)
Function ExistFile(FilePath : ComStr):Boolean;
Procedure CompletePath(Var Path : String);
Function GetHomeDir(EVar : String):PathStr;
Function DeleteFile(FileSpec : PathStr): Boolean;
Function FullName(FileName : ComStr):ComStr;
Function PickFile(Path : ComStr;FileName : String):ComStr;
Function NameOnly(F : ComStr):String;
Procedure MakeDir(Path : PathStr);
Function ExistDir(Path : PathStr):Boolean;
Function GetToken(Var Line : String;DoUp : Boolean):String;
Function ChangePathTo(FileName : ComStr;NewPath : PathStr):ComStr;

Implementation

(*--------------------------------------------------------------------------*)
Function ExistFile(FilePath : ComStr):Boolean;
Var Zoek: SearchRec;
Begin
FindFirst(FilePath,AnyFile,Zoek);
ExistFile:=(DosError=0);
End;

(*---------------------------------------------------------------------------*)
Function UpStr(S : String):String;
Var C : Byte;
Begin
For C:=1 To Length(S) Do
 S[C]:=Upcase(S[C]);
UpStr:=S;
End;

(*---------------------------------------------------------------------------*)
Function Nr2Str(Nr : Integer):String;
Var Temp : String;
Begin
Str(Nr,Temp);
Nr2Str:=Temp;
End;

Function Nr2FStr(Nr : Integer;Len : Byte):String;
Var Temp : String;
Begin
Str(Nr:Len,Temp);
Nr2FStr:=Temp;
End;

(*---------------------------------------------------------------------------*)
Function Str2Nr(S : String):Integer;
Var Err : Integer;
    Tmp : Integer;
Begin
Val(S,Tmp,Err);
If Err<>0
   Then Tmp:=0;
Str2Nr:=Tmp
End;


(*---------------------------------------------------------------------------*)
Function CleanUp(S : String):String;
Begin
While (S<>'') and (S[1]=' ') Do Delete(S,1,1);
While (S<>'') And (S[Length(S)]=' ') Do Dec(S[0]);
CleanUp:=S;
End;

(*---------------------------------------------------------------------------*)
Function SplitCommand(     InpStr : String;
                       Var ObjName: String;
                       Var Action : String):Boolean;
Begin
SplitCommand:=False;
If Pos('=',InpStR)=0
   Then Exit;
ObjName:=Copy(InpStr,1,Pos('=',InpStr)-1);
Action:=InpStr;
Delete(Action,1,Length(ObjName)+1);
SplitCommand:=True;
End;

(*---------------------------------------------------------------------------*)
Function Nr2DTStr(Nr : Word):String;
Var Tmp : String;
Begin
Str(Nr:2,Tmp);
If Tmp[1]=' '
   Then Tmp[1]:='0';
Nr2DTStr:=Tmp;
End;


(*---------------------------------------------------------------------------*)
Function MakeTimeString(Stamp : LongInt):String;
Var D       : DateTime;
    Tmp     : String[5];
Begin
UnpackTime(Stamp,D);
Tmp:=Nr2DTStr(D.Hour)+':'+Nr2DTStr(D.Min);
MakeTimeString:=Tmp;
End;


(*---------------------------------------------------------------------------*)
Const MonthList : Array[1..12] Of String[3] =
       ('Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec');

Function TimeStamp:String;
Var Year,Month,Day,
    Hour,Minute,Seconds     : Word;
    Dum                     : Word;
Begin
GetTime(Hour,Minute,Seconds,Dum);
GetDate(Year,Month,Day,Dum);
Dec(Year,1900);

TimeStamp:= Nr2DTStr(Hour)         +':'+
            Nr2DTStr(Minute)       +':'+
            Nr2DTStr(Seconds)      +' ('+
            Nr2DTStr(Day)          +' '+
            MonthList[Month]       +' '+
            Nr2DTStr(Year)         +')';

End;

Function MakeStr(S : String;C : Char;Len : Byte):String;
Begin
While Length(S)<Len Do
 S:=S+C;
MakeStr:=S;
End;


Function BitSet(L,Flag : LongInt):Boolean;
Begin
BitSet:=(L And Flag)=Flag;
End;

Procedure SetBit(Var L : LongInt; Flag : LongInt);
Begin
L:=L Or Flag;
End;

Procedure ReSetBit(Var L : LongInt; Flag : LongInt);
Begin
L:=L And (Flag Xor $FFFFFFFF);
End;

Procedure CompletePath(Var Path : String);
Begin
Path:=FExpand(Path);
If (Path[Length(Path)]<>'\') And
   (Path[Length(Path)]<>':')
   Then Path:=Path+'\';
End;


Function GetHomeDir(EVar : String):PathStr;
Var Tmp : String;
    Dum : String[10];
Begin
Tmp:=GetEnv(EVAR);
If Tmp='' Then FSplit(ParamStr(0),Tmp,Dum,Dum);
CompletePath(Tmp);
GetHomeDir:=Tmp;
End;

Function DeleteFile(FileSpec : PathStr): Boolean;
Var Search : SearchRec;
    Path   : PathStr;
    Tel    : Byte;
    Inp    : File;
Begin
DeleteFile:=True;
Tel:=Length(FileSpec);
While (Tel>0) And Not (FileSpec[Tel] In ['\',':']) Do
 Dec(Tel);
Path:=Copy(FileSpec,1,Tel);
FindFirst(FileSpec,Archive,Search);
While DosError=0 Do
 Begin
 If (Search.Attr And Directory)<>Directory
    Then Begin
         Assign(Inp,Path+Search.Name);
         Erase(Inp);
         If IoResult<>0
            Then Begin
                 SetFAttr(Inp,0);
                 Erase(Inp);
                 If IoResult<>0
                    Then Begin
                         DeleteFile:=False;
                         Exit;
                         End;
                 End;
         End;
 FindNext(Search);
 End;
If IoResult<>0
   Then;
End;

Function NameOnly(F : ComStr):String;
Var Name,Ext : String[10];
    P        : PathStr;
Begin
FSplit(F,P,Name,Ext);
NameOnly:=Name+Ext;
End;

Var Hlp : Byte;

Procedure MakeDir(Path : PathStr);
Var Mem : String[12];
Begin
If Path='' Then Exit;
MkDir(Path);
If IoResult=3
   Then Begin
        Hlp:=Length(Path);
        While (Hlp>0) and (Path[Hlp]<>'\') do
         Dec(Hlp);
        Mem:=Copy(Path,Hlp+1,Length(Path)-Hlp);
        Path[0]:=Chr(Hlp-1);
        MakeDir(Path);
        MkDir(Path+'\'+Mem);
        If IoResult<>0
           Then Exit;
        End;
End;

Function ExistDir(Path : PathStr):Boolean;
Var S : SearchRec;
Begin
ExistDir:=True;
CompletePath(Path);
If (Length(Path)=3) and (Path[2]=':')
   Then Exit;
Dec(Path[0]);
FindFirst(Path,Directory,S);
ExistDir:=(DosError=0) And ((S.Attr and Directory)=Directory);
End;

Function FullName(FileName : ComStr):ComStr;
Var S : SearchRec;
Begin
FindFirst(FileName+'.*',AnyFile,S);
While (DosError=0) And ((S.Attr and Directory)=Directory) Do
 FindNext(S);
If DosError=0
   Then FullName:=S.Name
   Else FullName:=FileName+'.???';
End;

Function PickFile(Path : ComStr;FileName : String):ComStr;
Var S : SearchRec;
Begin
FindFirst(Path+FileName,AnyFile,S);
If DosError=0
   Then PickFile:=Path+S.Name
   Else PickFile:='';
End;

Function GetToken(Var Line : String;DoUp : Boolean):String;
Var Tmp : Byte;
    Out : String;
Begin
Tmp:=1;
Out:='';
While (Line[1] in [' ',#09]) And (Line<>'') Do
  Delete(Line,1,1);

While (Tmp<=Length(Line)) And (Line[Tmp]<>' ') Do
 Begin
 If DoUp
    Then Out:=Out+Upcase(Line[Tmp])
    Else Out:=Out+Line[Tmp];
 Inc(Tmp);
 End;
Delete(Line,1,Length(Out)+1);

While (Line[1] in [' ',#09]) And (Line<>'') Do
  Delete(Line,1,1);

GetToken:=Out;
End;

Function ChangePathTo(FileName : ComStr;NewPath : PathStr):ComStr;
Begin
ChangePathTo:=NewPath+NameOnly(FileName);
End;

End.